home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / tpascal / bpvbx / debug.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-17  |  2.7 KB  |  124 lines
  1. Unit Debug;
  2.  
  3. interface
  4.  
  5. uses
  6.     wsstring,
  7.     WinDos,
  8.     WinCrt;
  9.  
  10. procedure initDebug;
  11.  
  12. procedure WriteDebug(msg: pChar);
  13.  
  14. procedure WriteDebugValue(p: string; m1: pchar);
  15.  
  16. procedure WriteDebugValues(p: string; m1, m2, m3: pchar);
  17.  
  18. procedure WriteDebugNumber(p: string; m1: longInt);
  19.  
  20. procedure WriteDebugChar(p: string; m1: char);
  21.  
  22. procedure WriteDebugMessages(p: string; m1, m2, m3: longInt);
  23.  
  24. var
  25.     D:    text;
  26.  
  27. implementation
  28.  
  29. procedure initDebug;
  30. begin
  31.     assign(D, 'Debug.TxT');
  32.     reWrite(D);
  33.     writeln('VBDOS DEBUG');
  34.     close(D);
  35. end;
  36.  
  37. procedure reopenDebug;
  38. begin
  39.     append(D);
  40. end;
  41.  
  42. procedure closeDebug;
  43. begin
  44.     close(D);
  45. end;
  46.  
  47. function interpret(msg: longInt): string;
  48. var
  49.     hexrep: array[0..12] of char;
  50.     hexstr:    string;
  51. begin
  52.     HexL(hexrep, msg);
  53.     hexstr[0] := #4;
  54.     hexstr[1] := hexrep[4];
  55.     hexstr[2] := hexrep[5];
  56.     hexstr[3] := hexrep[6];
  57.     hexstr[4] := hexrep[7];
  58.     case msg of
  59.         1:        interpret := '0x0001 WM_Create           ';
  60.         $5:        interpret := '0x0005 WM_Size             ';
  61.         $F:        interpret := '0x000F WM_Paint            ';
  62.         $14:    interpret := '0x0014 WM_EraseBkGnd       ';
  63.         $18:    interpret := '0x0018 WM_ShowWindow       ';
  64.         $21:    interpret := '0x0021 WM_MouseActivate    ';
  65.         $22:    interpret := '0x0022 WM_ChildActivate    ';
  66.         $24:    interpret := '0x0024 WM_GetMinMaxInfo    ';
  67.         $31:    interpret := '0x0031 WM_GetFont          ';
  68.         $46:    interpret := '0x0046 WM_WindowPosChanging';
  69.         $47:    interpret := '0x0047 WM_WindowPosChanged ';
  70.         $71:    interpret := '0x0071 WM_WindowPosChanged ';
  71.         $81:    interpret := '0x0081 WM_NCCreate         ';
  72.         $83:    interpret := '0x0083 WM_NCCalcSize       ';
  73.         $1002:    interpret := '0x1002 VBM_Initialize      ';
  74.         $100A:    interpret := '0x100A VBM_QPASTEOK        ';
  75.         $1017:    interpret := '0x1017 VBM_PaintOutline    ';
  76.         $2210:    interpret := '0x2210 VBM_ParentNotify    ';
  77.         else    interpret := '0x' + hexstr + '     Unknown             ';
  78.     end;
  79. end;
  80.  
  81. procedure WriteDebug(msg: pChar);
  82. begin
  83.     reopenDebug;
  84.     writeln(D, Msg);
  85.     closeDebug;
  86. end;
  87.  
  88. procedure WriteDebugValue(p: string; m1: pchar);
  89. begin
  90.     reopenDebug;
  91.     writeLn(D, p, ' ', m1);
  92.     closeDebug;
  93. end;
  94.  
  95. procedure WriteDebugValues(p: string; m1, m2, m3: pchar);
  96. begin
  97.     reopenDebug;
  98.     writeLn(D, p, ' ', m1, ' ', m2, ' ',m3);
  99.     closeDebug;
  100. end;
  101.  
  102. procedure WriteDebugNumber(p: string; m1: longInt);
  103. begin
  104.     reopenDebug;
  105.     writeLn(D, p, ' ', m1);
  106.     closeDebug;
  107. end;
  108.  
  109. procedure WriteDebugChar(p: string; m1: char);
  110. begin
  111.     reopenDebug;
  112.     writeLn(D, p, ' ', m1);
  113.     closeDebug;
  114. end;
  115.  
  116. procedure WriteDebugMessages(p: string; m1, m2, m3: longInt);
  117. begin
  118.     reopenDebug;
  119.     writeLn(D, p, ' ', interpret(m1), ' ', m2, ' ',m3);
  120.     closeDebug;
  121. end;
  122.  
  123.  
  124. end.